perm filename SLUG.F4[CMS,LCS]1 blob
sn#099803 filedate 1974-04-29 generic text, type T, neo UTF8
00100 DIMENSION NL(72),NE(50),IE(1000),NW(1000)
00200 COMMON NL,NE,IE,NW,J,M,N
00300
00400 1 J=J+1
00500 L=0
00600 CALL IREAD(L)
00700 IF(L)GO TO 1
00800 J=J-1
00900 TYPE 10
01000 10 FORMAT(' TYPE LINE NUM'/)
01100 ACCEPT 11,NA
01200 11 FORMAT(A1)
01300 IF(NA.NE.' ')GO TO 33
01400 LN=0
01500 35 LN=LN+1
01600 36 IF(LN.GT.J)GO TO 1
01700 CALL IRITE(LN)
01800 25 TYPE 14,NL
01900 14 FORMAT(1X72A1/)
02000 IF(NA.EQ.' ')GO TO 35
02100 GO TO 1
02200 33 REREAD 34,LN
02300 34 FORMAT(I2)
02400 IF(LN.LT.1)GO TO 13
02500 GO TO 36
02600 13 TYPE 6,(NE(I),I=1,J)
02700 6 FORMAT(1X10I7)
02800 TYPE 6,(IE(I),I=1,M)
02900 TYPE 7,(NW(I),I=1,N)
03000 7 FORMAT(1X70A1)
03100 TYPE 8,J,M,N
03200 8 FORMAT(1X3I/)
03300 GO TO 1
03400 END
03500
03600 SUBROUTINE IREAD(L)
03700 COMMON NL(72),NE(50),IE(1000),NW(1000),J,M,N
03800 LT=0
03900 1 ACCEPT 2,NL
04000 2 FORMAT(72A1)
04100 CALL JOKES(LT,NL(1))
04200 IF(LT)GO TO 4
04300 IF(L)GO TO 1
04400 RETURN
04500
04600 4 CALL DOG(NL,J,M,N,NE,IE,NW)
04700 L=-1
04800 RETURN
04900 END
05000
05100 SUBROUTINE IRITE(LN)
05200 COMMON NL(72),NE(50),IE(1000),NW(1000),J,M,N
05300 I=0
05400 NN=NE(LN)/1000
05500 MM=MOD(NE(LN),1000)+1
05600 23 I=I+1
05700 IF(NN.EQ.MM)GO TO 19
05800 KM=IE(NN)/100
05900 LL=KM+MOD(IE(NN),100)
06000 24 IF(KM.EQ.LL)GO TO 20
06100 NL(I)=NW(KM)
06200 IF(I.EQ.72)RETURN
06300 KM=KM+1
06400 I=I+1
06500 GO TO 24
06600 20 IF(NN.LT.MM)NN=NN+1
06700 19 NL(I)=' '
06800 IF(I.EQ.72)RETURN
06900 GO TO 23
07000 END
07100